perm filename PX.F4[PIC,LCS]4 blob
sn#251274 filedate 1976-12-05 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE PLOU(NEWEND)
C00011 ENDMK
Cā;
SUBROUTINE PLOU(NEWEND)
COMMON/JOMMAC/ILINE,JLINE,KSIDE,MSIDE,NEWZ /OUTF/IPLT,IXGP
1 /JEXCH/JEXCH
COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,ROT,RLR,RUD,CONST,E
1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A,IA,IB,IC,ID
C KA-D IS FOR INVIS. INNER AREA. IA-D IS FOR INVIS. OUTER AREA.
COMMON/DRW/JDRW(2000)/FU/FUJ(512),JJX,RDIV,ADML
EQUIVALENCE(JDRW,INP)
COMMON/DDP/IDP1(4000)
DIMENSION INP(10,200)
COMMON/MEDGE/MC,MD,RMC,MMD/CLR/KP,KQ,KR,KS,P
COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
1 LSIDE,RSIDE,DTA,HYSTAB(1)
INTEGER FLINE,RSIDE
DATA NEWX/0/,NCNT/0/,JMC/1554/,JMD/1380/,RTO/6./,BITS/4/
NEWEND=NEWZ
IF(NEWEND.EQ.0)RETURN
IF(NEWEND)GO TO 6002
IF(NEWX)GO TO 1
FLINE=ILINE
LLINE=JLINE
LSIDE=KSIDE
RSIDE=MSIDE
NX=0
NY=0
1001 FORMAT(A1,3F)
1000 FORMAT(' D, P, S, M OR T HORZ.%,VRT.%, ROTATION'/)
C TYPE 'X' INSTEAD OF 'P' FOR XGP SHIFT TO LEFT IN PLT DATA.
6100 FORMAT(' INNER CLEAR AREA L-R-BT-TP% OUTER L-R-B-T%
1 REV=1, INV=1 2ND INNER CLR'/)
6001 FORMAT(14F)
1 CALL JZERO
JX=0
JY=0
CONST=0
TYPE 1000
ACCEPT 1001,WHICH,RLR,RUD,ROT
IF(WHICH.EQ.'R')RETURN
IF(WHICH.NE.'C')GO TO 24
NEWX=0
GO TO 1
C TYPE 'R' TO GO BACK TO FILE TYPE-IN.
CC IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
24 NCNT=NCNT+1
REREAD 3,(INP(NA,NCNT),NA=1,10)
IF(WHICH.EQ.'?')GO TO 9003
C ******* ? OR H FOR HELP ********
IF(WHICH.NE.'H')GO TO 8002
9003 TYPE 9002
GO TO 1
9002 FORMAT(' D=DISPLAY, P OR X=PLOT, S=SAVE FOR DRAWING PROG.'/
1 ' M=MOVE, T=TYPE MY INPUT BACK.'/)
8002 IF(WHICH.NE.'T')GO TO 3002
6002 TYPE 91,RDIV,JJX
91 FORMAT(' CENTR=',F6.2,' STEP=',I2)
DO 4002 K=1,NCNT
4002 TYPE 5002,(INP(NA,K),NA=1,10)
IF(NEWEND)RETURN
GO TO 1000
3002 IF(WHICH.EQ.'M')GO TO 3102
IXGP=0
IF(WHICH.NE.'X')GO TO 2
IXGP=-1
WHICH='P'
2 TYPE 6100
ACCEPT 6001,A,B,C,D,E,F,G,H,REV,RINV,P,Q,R,S
C TYPE -1 TO REPEAT LAST INPUT
IF(A.GE.0)GO TO 33
C REPEATS LAST INPUT
A=AA
B=BB
C=CC
D=DD
E=EE
F=FF
G=GG
H=HH
REV=RREV
RINV=RRINV
P=PP
Q=QQ
R=RR
S=SS
33 AA=A
BB=B
CC=C
DD=D
EE=E
FF=F
GG=G
HH=H
JEXCH=0
IF(REV.LT.100)GO TO 133
JEXCH=-1
REV=REV-100
133 RREV=REV
RRINV=RINV
SS=S
PP=P
QQ=Q
RR=R
IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
REREAD 3,(INP(NA,NCNT),NA=1,10)
3102 JPL=3
WX=WHICH
C SO IT WON'T COUNT RETRIES.
3 FORMAT(10A5)
5002 FORMAT(1X10A5)
C FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
C-- D 0 0 0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
C TYPE 'T' TO GET BACK ALL INPUT LINES.
IF(A+B+C+D.EQ.0)A=-1.
C 'N'= PLOT, BUT NO X
IF(WHICH.NE.'S')GO TO 7002
WHICH='P'
CONST=-1
7002 IF(WHICH.EQ.'M')GO TO 2002
IF(E+H+F+G.EQ.0)E=-1.
IF(P+Q+R+S.EQ.0)P=-1.
IF(RLR.EQ.0)RLR=100.
IF(RUD.EQ.0)RUD=100.
IF(ROT.EQ.1)RINV=RINV-1
2002 RLR=RLR/100.
RUD=RUD/100.
PLT=0
IF(WHICH.NE.'D')GO TO 1002
C DPY IS 1/3 SIZE OF PLOT.
GO TO 2000
1102 IF(WHICH.NE.'M')GO TO 1
C MOVE PEN, L-R%, U-D
2200 RX=JMC
RY=JMD
NX=RX*RLR
NY=RY*RUD
RLR=.01
RUD=.01
GO TO 67
1002 IF(WHICH.NE.'P')GO TO 1102
PLT=1
2000 IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
67 MA=0
MB=0
MC=(RSIDE-LSIDE)*RTO*RLR+.5
MD=(LLINE-FLINE)*RTO*RUD+.5
JREV=MC/JPL
JINV=MD/JPL
JM=-380
KM=-200
IF(NEWX)GO TO 655
JMC=MC
JMD=MD
655 JQX=NX
JQY=NY
IF(WHICH.EQ.'M')GO TO 671
KA=0
KB=0
KC=0
KD=0
KP=0
KQ=0
KR=0
KS=0
IA=-1
IB=99999
IC=-1
ID=99999
671 IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
CALL SETPOG(1)
CALL TYPLOC(-300,-611)
CALL DPYBRT(6)
JX=NX/JPL
JY=NY/JPL
CALL AIVECT(-380,-200)
672 JA=0
JB=0
NC=MC/JPL
ND=MD/JPL
CALL DSTORT(JPL)
CALL LINES(3)
JA=NC
JB=0
CALL LINES(2)
JA=NC
JB=ND
CALL LINES(2)
JB=ND
JA=0
CALL LINES(2)
JA=0
JB=0
CALL LINES(2)
CALL DPYOUT(1)
IF(WHICH.NE.'M')GO TO 2683
168 NY=JQY
NX=JQX
GO TO 1
2683 NQ=0
IF(A)GO TO 1683
KA=MC*(A/100.)
KB=MC*(B/100.)
KC=MD*(C/100.)
KD=MD*(D/100.)
CALL INVIS(KA,KB,KC,KD,NQ)
1683 IF(P)GO TO 9683
KP=MC*(P/100.)
KQ=MC*(Q/100.)
KR=MD*(R/100.)
KS=MD*(S/100.)
CALL INVIS(KP,KQ,KR,KS,NQ)
9683 IF(E)GO TO 8683
IA=MC*(E/100.)
IB=MC*(F/100.)
IC=MD*(G/100.)
ID=MD*(H/100.)
CALL INVIS(IA,IB,IC,ID,NQ)
IF(PLT.EQ.0)E=-1
8683 IF(PLT.NE.0)JPL=1
KA=KA/JPL
KB=KB/JPL
KC=KC/JPL
KD=KD/JPL
KP=KP/JPL
KQ=KQ/JPL
KR=KR/JPL
KS=KS/JPL
IA=IA/JPL
IB=IB/JPL
IC=IC/JPL
ID=ID/JPL
TYPE 683
683 FORMAT(' OK?'/)
ACCEPT 1001,NA
IF(NA.EQ.'N')GO TO 168
JX=NX/JPL
JY=NY/JPL
IF(PLT.NE.0)GO TO 657
6852 CALL CLRPOG(2)
CALL SETPOG(1)
CC JA=-380
CC JB=-200
CALL JZERO
CALL AIVECT(-380,-200)
GO TO 685
657 FORMAT(' OUTER LIMITS')
TYPE 65,MA,MC,MB,MD
C OUTER COORDINATES
50 FORMAT(' DO YOU WANT THE FRAME ?'/)
CXX1681 TYPE 50
1681 ALFAB=0
GO TO 681
C NEVER A FRAME UNLESS THIS JRST IS REMOVED.
65 FORMAT(' LFT=',I4,' RT=',I4,' BOT=',I4,' TOP=',I4)
ACCEPT 1001,ALFAB
IF(NEWX.NE.-1)CALL PLOTS(I)
681 PLT=-1
IF(ALFAB.NE.'Y') GOTO 685
JX=NX
JY=NY
JA=0
JB=0
CALL DSTORT(JPL)
CALL LINES(3)
JA=MC
JB=0
CALL LINES(2)
JA=MC
JB=MD
CALL LINES(2)
JA=0
JB=MD
CALL LINES(2)
JA=0
JB=0
CALL LINES(2)
685 JAR=0
JBR=0
JREV=MC/JPL
JINV=MD/JPL
IF(CONST)PLT=-2
CALL DSTORT(JPL)
CALL PLTMAN
NEWX=-1
NX=JQX
NY=JQY
WX=0
IPLT=1
IF(PLT)CALL PLOT(0,0,3)
NEWEND=0
END